home *** CD-ROM | disk | FTP | other *** search
/ PC go! 2008 April / PCgo 2008-04 (DVD).iso / interface / contents / demoversionen_3846 / 13664 / files / Data1.cab / vbnettool.vb < prev    next >
Encoding:
Text File  |  2004-02-17  |  6.5 KB  |  160 lines
  1. '/******************************************************************/
  2. '/*                                                                */
  3. '/*                      TurboCAD for Windows                      */
  4. '/*                   Copyright (c) 1993 - 2004                    */
  5. '/*             International Microcomputer Software, Inc.         */
  6. '/*                            (IMSI)                              */
  7. '/*                      All rights reserved.                      */
  8. '/*                                                                */
  9. '/******************************************************************/
  10.  
  11. Public Class VBNetTCTool
  12.     Const NUM_TOOLS = 1
  13.     Const boolLoadFromBmp = False
  14.     Public Function Description() As String
  15.         Description = "TurboCAD VB NET Tool"
  16.     End Function
  17.     Public Function Run(ByVal Tool As Object) As Boolean
  18.         ' add your code here
  19.         MsgBox("Add your code here !!!")
  20.     End Function
  21.  
  22.     Public Function GetToolInfo(ByRef CommandNames As Object, ByRef MenuCaptions As Object, ByRef StatusPrompts As Object, _
  23.     ByRef ToolTips As Object, ByRef Enabled As Object, ByRef WantsUpdates As Object) As Integer
  24.         Dim StrCommandNames() As String
  25.         Dim StrMenuCaptions(,) As String
  26.         Dim StrStatusPrompts() As String
  27.         Dim StrToolTips() As String
  28.  
  29.         Dim BoolEnabled() As Boolean
  30.         Dim BoolWantsUpdates() As Boolean
  31.  
  32.         ReDim StrCommandNames(NUM_TOOLS - 1)
  33.         ReDim StrMenuCaptions(NUM_TOOLS - 1, 1)
  34.         ReDim StrStatusPrompts(NUM_TOOLS - 1)
  35.         ReDim StrToolTips(NUM_TOOLS - 1)
  36.         ReDim BoolEnabled(NUM_TOOLS - 1)
  37.         ReDim BoolWantsUpdates(NUM_TOOLS - 1)
  38.  
  39.         StrCommandNames(0) = "Bonus Tools|VB NET tools|&TC VB NET Test Tool"
  40.  
  41.         StrMenuCaptions(0, 0) = "&TC VB NET Test Tool"
  42.         ' toolbar's name
  43.         StrMenuCaptions(0, 1) = "VB NET SDK samples"
  44.  
  45.         StrStatusPrompts(0) = "TC VB NET tool status prompt"
  46.         StrToolTips(0) = "TC VB Net Tool tooltips"
  47.  
  48.         BoolEnabled(0) = True
  49.         BoolWantsUpdates(0) = False
  50.  
  51.  
  52.         MenuCaptions = StrMenuCaptions
  53.         CommandNames = StrCommandNames
  54.         StatusPrompts = StrStatusPrompts
  55.         ToolTips = StrToolTips
  56.         Enabled = BoolEnabled
  57.         WantsUpdates = BoolWantsUpdates
  58.         GetToolInfo = NUM_TOOLS
  59.     End Function
  60.     Public Function GetPicture(ByVal LargeImage As Boolean, ByVal MonoImage As Boolean) As Object
  61.         On Error GoTo PictureError
  62.         Dim TheImage As System.Drawing.Bitmap
  63.         If GetButtonPicture(LargeImage, MonoImage, TheImage) Then
  64.             Dim imConv As New ImageConverter("59EE46BA-677D-4d20-BF10-8D8067CB8B33")
  65.             ' now we have bitmap. we need to convert it to IPicture
  66.             GetPicture = imConv.ImageToIPicDisp(TheImage)
  67.         End If
  68.         Exit Function
  69. PictureError:
  70.         MsgBox("GetPicture method failed " & Err.Description)
  71.         GetPicture = Nothing
  72.     End Function
  73.     Public Function Initialize(ByVal Tool As Object) As Boolean
  74.         Initialize = True
  75.     End Function
  76.     Public Function UpdateToolStatus(ByVal Tool As Object, ByVal Enabled As Boolean, ByVal Checked As Boolean) As Boolean
  77.         Enabled = True 'Could do a test here to determine whether to disable the button/menu item
  78.         Checked = False  'Could do a test here to determine whether to check the button/menu item
  79.         UpdateToolStatus = True
  80.     End Function
  81.     Private Function GetButtonPicture(ByVal LargeImage As Boolean, ByVal MonoImage As Boolean, ByRef TheImage As Object) As Boolean
  82.         On Error GoTo LoadError
  83.         Dim s As String, s1 As String
  84.         'define correct path to the icons here' 
  85.         s = "C:\\temp\\LargeIcon.bmp"
  86.         s1 = "C:\\Temp\\SmallIcon.bmp"
  87.         ' copy of these bmp files are located in TCVBNETTool directory
  88.         'There are two ways to load images:  from .Bmp file(s) or from .RES resource.
  89.         'In this demo, we control the loading by a private variable.
  90.         Dim img As System.Drawing.Image
  91.         Dim thisApp As System.Reflection.Assembly
  92.         Dim file As System.IO.Stream
  93.  
  94.         If boolLoadFromBmp Then
  95.             If LargeImage Then
  96.                 img = System.Drawing.Image.FromFile(s1) '"LargeIcon.bmp")
  97.             Else
  98.                 img = System.Drawing.Image.FromFile(s) '"SmallIcon.bmp")
  99.             End If
  100.         Else
  101.             If LargeImage Then
  102.                 thisApp = System.Reflection.Assembly.GetExecutingAssembly()
  103.                 file = thisApp.GetManifestResourceStream("TCVBNETTool.LargeIcon.bmp")
  104.                 img = System.Drawing.Image.FromStream(file)
  105.             Else
  106.                 thisApp = System.Reflection.Assembly.GetExecutingAssembly()
  107.                 file = thisApp.GetManifestResourceStream("TCVBNETTool.SmallIcon.bmp")
  108.                 img = System.Drawing.Image.FromStream(file)
  109.             End If
  110.  
  111.         End If
  112.         ' return bitmap
  113.         TheImage = img
  114.         GetButtonPicture = True
  115.         Exit Function
  116.  
  117.  
  118.  
  119. LoadError:
  120.         GetButtonPicture = False
  121.     End Function
  122.     Public Function CopyBitmap(ByVal LargeImage As Boolean, ByVal MonoImage As Boolean) As Boolean
  123.  
  124.         On Error GoTo BitmapError
  125.         Dim TheImage As System.Drawing.Bitmap
  126.         If GetButtonPicture(LargeImage, MonoImage, TheImage) Then
  127.             'Put the image on the Windows clipboard
  128.             '            Dim datobj As New System.Windows.Forms.DataObject
  129.             '            datobj = New System.Windows.Forms.DataObject(System.Windows.Forms.DataFormats.Dib, TheImage)
  130.             System.Windows.Forms.Clipboard.SetDataObject(TheImage, True)
  131.             CopyBitmap = True
  132.             Exit Function
  133.         End If
  134.         Exit Function
  135.         CopyBitmap = True
  136.         Exit Function
  137.  
  138. BitmapError:
  139.         MsgBox("CopyBitmap method failed " & Err.Description)
  140.         CopyBitmap = False
  141.     End Function
  142.     Private Class ImageConverter
  143.         Inherits System.Windows.Forms.AxHost
  144.  
  145.         Public Sub New(ByVal pGUID As String)
  146.             MyBase.New(pGUID)
  147.         End Sub
  148.  
  149.         Public Shared Function ImageToIPicDisp(ByVal value As System.Drawing.Image) As stdole.IPictureDisp
  150.             Return System.Windows.Forms.AxHost.GetIPictureDispFromPicture(value)
  151.         End Function
  152.  
  153.         Public Shared Function IPicDispToImage(ByVal value As stdole.IPictureDisp) As System.Drawing.Image
  154.             Return System.Windows.Forms.AxHost.GetPictureFromIPictureDisp(CType(value, Object))
  155.         End Function
  156.     End Class
  157.  
  158.  
  159. End Class
  160.